perm filename SPACER.F4[P11,LCS]1 blob
sn#573345 filedate 1981-03-17 generic text, type T, neo UTF8
C***** SPACER,JDRAW,EXTEN,RTLINE,THICK,RBJX,CENTX,CENTER,LINX
C***** UNPACK,ROFF,NOZERO,BMS,RHORZ
SUBROUTINE SPACER(J5,IFNT,RB,R)
C **** THIS IS FROM ALPHA.FAI
C SPACES ALPHABET ITEMS.
DATA RS/1.08/,RSPC/1./,RLWR/.96/,BLANK/0.7/
C JUMP TO USE PRIMITIVE ALPHABET.
IF(J5.GT.47)GO TO 10
IF(J5.LE.9)GO TO 177
IF(J5.LT.36)GO TO 10
C NEXT FOR NUMBERS, SPACE AND PUNCTUATION.
CZ177 RSX=BLANK
CZ IF(IFNT)RSX=.9
177 RSX=1.0
IF(J5.EQ.47)RSX=BLANK
IF(IFNT.LT.0)RSX=.9
IF(J5.NE.39)GO TO 3
C IF IT IS '=' THEN USE 1.2096
RSX=1.2096
GO TO 21
10 IF(J5.LT.47)GO TO 5
IF(J5.EQ.52)GO TO 14
IF(J5.GE.55)GO TO 5
C PUNCT. WILL EXPAND ABOVE 54.
RETURN
14 IFNT=0
C #=52=PRIMITIVE
JA=10
RETURN
5 RSX=RS
IF(IFNT.LT.0)RSX=RLWR
C FOR LOWER CASE SPACING. (96%)
IF(J5.EQ.22.OR.J5.EQ.69.OR.J5.EQ.59.OR.J5.EQ.59)GO TO 277
C JUMP IF 1/8 NOTE OR 'M' OR 1/4 OR 1/2
IF(J5.NE.32)GO TO 3
277 RSX=RSX*1.12
C FOR M AND W
3 IF(J5.GE.36)GO TO 21
IF(J5.EQ.1)GO TO 21
IF(J5.EQ.18)GO TO 21
IF(J5.EQ.19)GO TO 21
C FOR 1,I AND J
IF(IFNT.GE.0)GO TO 4
C NEXT FOR LOWER CASE ONLY.
IF(J5.EQ.15)GO TO 21
IF(J5.EQ.19)GO TO 21
IF(J5.EQ.21)GO TO 21
IF(J5.NE.29)GO TO 4
21 IF(J5.NE.47)RSX=RSX*.68
C FOR F,I,J,L,T
4 RB=RB+R*RSX
END
C**** ALL FOLLOWING ARE FROM MFAIL.FAI
SUBROUTINE JDRAW(M,R3,CENTR,RSTJ2,RX,RY)
C USES DATA FROM DRW PROGRAM.
COMMON/LLL/L
DIMENSION M(1)
RC=RX*RSTJ2
RD=RY*RSTJ2
DO 2 K=2,M(1)
CALL UNPACK(IA,IB,M(K))
2 CALL LINES(FLOAT(IA)*RC+R3,FLOAT(IB)*RD+CENTR,L)
END
SUBROUTINE CENTER(CNTR)
C TO CENTER ITEMS CREATED WITH DRAWING PROG.
COMMON /STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,POS
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
EQUIVALENCE (R4,RJQ(2))
CNTR=POS+(2+AMOD(R4,100.)*7)*RSTJ2
END
SUBROUTINE LINX(A,B,C,D)
C SAVES SPACE FOR SINGLE LINES.
CALL LINES(A,B,3)
CALL LINES(C,D,2)
END
SUBROUTINE UNPACK(M,N,I)
C UNPACKS VECTORS FROM DRW PROGRAM.
C EACH WD = N/AXXX/BYYY IF N.NE.0 =INVIS. LINE.
C IF A=1 THEN X IS NEG. IF B=1, Y IS NEG.
COMMON/LLL/L
C L IS FOR VIS. OR INVIS. LINES.
N=I
L=2
M=N/100000000
IF(M.EQ.0)GO TO 2
L=3
N=N-100000000*M
2 M=N/10000
IF(M.GT.1000)M=1000-M
N=MOD(N,10000)
IF(N.GT.1000)N=1000-N
END
FUNCTION EXTEN(X)
EXTEN=AMOD(X,1.0)*10.
END
FUNCTION ROFF(R)
C FOR ROUND OFF
S=.5
IF(R.LT.0)S=-S
ROFF=R+S
END
SUBROUTINE NOZERO(X)
IF(X.EQ.0)X=1.
END
SUBROUTINE EXCH(X,Y)
Z=X
X=Y
Y=Z
END
SUBROUTINE BMS
COMMON /STF/RS(8),RSTJ2 /BM/RA,RC,RKY
Y=RC*RSTJ2+RKY
CALL LINES(RA,Y,2)
END
FUNCTION RHORZ(R)
RHORZ=R*5.96-596.
END
C ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
CF IPOS=ROFF(RJQ(1)*DIS)
CCCF IF(RMINI.LT..9)IPOS=IPOS+1
CF JPOS=ROFF(CENTR*RHT)
CF IF(-RMINI.EQ.PRE)GO TO 10
CF PRE=-RMINI
CCCF D=.25*RMINI
CF D=.25
CF B=BH*RMINI*RHT
CF E=RMINI*DIS
CF A=BL*E
CF IC=A
CF A=A*A
CF E=-B/4.
CF K=B
CF B=B*B
C USES EQUATION FOR ELLIPSE
CF N=1
CF NX=2
CF6 DO 1 J=-K,K
CF Y=J*J
CF X=SQRT(A-(A*Y)/B)
CF L=E-X
CF M=X+E
C THE TWO SIDES OF THE LINE
CF IF(N)CALL EXCH(L,M)
CF IRN(NX)=L
CF IRN(NX+1)=M
C C IS VERTICAL POS.
CF NX=NX+2
CF E=E+D
C E IS TO TILT IT.
CF1 N=-N
CF10 CALL PLOT(IPOS+3,JPOS,3)
CF N=2
C 1ST LOC. OF ARRAY HAS "PRE"
CF L=IPOS+IC
CF DO 11 M=-K,K
CF J=M+JPOS
CF CALL PLOT(L+IRN(N),J,2)
CF CALL PLOT(L+IRN(N+1),J,2)
CF11 N=N+2
CF END
SUBROUTINE RJBX(R)
COMMON R2,JA,CN,J2,R3/STF/RSTFAC(8),RSTJ2
R3=R3+R*RSTJ2
END
SUBROUTINE CENTX
COMMON R2,JA,CENTR,D,E,R4,R(38) /STF/RSTFAC(8),RSTJ2
1 /POSI/STFF(8),JJ2,POS
CENTR=AMOD(R4,100.0)
IF(JA.EQ.8)GO TO 1
C STAFF CAN BE AT ANY LEVEL UP TO 99.9 + OR -
CR=0
IF(CENTR.LT.-80.)CR=100.
IF(CENTR.GE.80.)CR=-100.
R4=CENTR+CR
1 CENTR=POS+RSTJ2*((CENTR*7.)-18.)
END
CC CENTR=POS-18.*RSTJ2+AMOD(R4,100.0)*RSTJ2*7.
C******** THE ABOVE ARE NOW IN SMALL.FAI (3/75)
C****** 7, STF, POS, HGT, NUM OF SHARPS OR FLATS(+ OR -), CLEF
C ( CLEF = TREB,0 BASS,1 ALT,2 TEN,3 )
FUNCTION RTLINE(L)
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(1)
C CHECKS TO SEEIF R2 HAS STAFF NUM DESIRED. (IF >7, ALL STAVES OK)
IF(R2.GT.7)GO TO 1
IF(RN(L+2).NE.R2)GO TO 2
1 RTLINE=0
C RIGHT STAFF
RETURN
2 RTLINE=-1
C WRONG STAFF
END
SUBROUTINE THICK
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
1 /STF/RS(8),RSTJ2 /PLTR/PLT,RHT,DIS,XDIS
EQUIVALENCE (R8,RJQ(6)),(J8,JQ(6)),(J9,JQ(7)),(J4,JQ(2))
C RETURNS NUMBER OF THICKNESSES IN J8 AND "SCALED" STEP IN R8
C NEXT J8 = 1→99 =X THICKNESS, =100→ = Y THICKNESS
R8=AMOD(R8,100.0)
J9=J8/100
J8=R8
J4=-1
C FLAG FOR SINGLE ADDED VERTICAL THICKNESS, NO MATTER WHAT SIZE. R8=.5
IF(R8.NE.J8)J4=0
R9=RSTJ2*DIS
C R8 AND R9 ARE FACTORS TO CAUSE RIGHT NUM OF LINES FOR THICKNESS.
J8=J8*R9
J9=J9*R9
IF(J9.NE.0.AND.J8.NE.0)J9=J8
C IF BOTH X AND Y THICKNESS ARE USED THEY WILL BECOME EQUAL!
CC IF(J4)GO TO 1
IF(J4.GE.0)J9=1
C SINGLE ADDED THICKNESS, NO MATTER WHAT SIZE.; R8=1
END